package lib::TextTreatment;

# This file is part of noplagia.
#
# noplagia is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# noplagia is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# noplagia; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA  02111-1307 USA

use strict;

require Exporter;
our ($VERSION,@ISA,@EXPORT,$context);

$VERSION = 0.01;

=head1 NAME

lib::TextTreatment - Bibliotheque de manipulation de texte

=head1 SYNOPSIS

    &get_occurences
    &set_noPunctuation

=head1 DESCRIPTION

    Ce module permet d'obtenir des informations ou d'effectuer des traitements sur le
    texte

=head1 FUNCTIONS

=over 2

=cut

@ISA    = qw(Exporter);
@EXPORT = qw(
  &get_occurences &set_noPunctuation &get_language &get_name_of &set_nocase &set_baliser
);

=item get_occurences

 Fonction retournant un hash, ainsi qu'une liste de ses clefs triées
 selon l'ordre decroissant de ses valeurs associées.

 Attention: le texte fourni devrait être soustrait de toute ponctuation.

=cut

sub get_occurences{
    my $text = shift;
    my %h;
    my @words = split(' ', $text);
    foreach my $word (@words){
        $h{$word}++;
    }
    my @occurence_sorted = sort {$h{$b} <=> $h{$a}}  keys(%h);
    return (\%h, \@occurence_sorted);
}

=item set_noPunctuation

 Fonction supprimant la ponctuation d'un texte

=cut

sub set_noPunctuation{
    my $text = shift;
    $text =~  s/[\s\Q.?!:,;"-\)(][}{<>\E]+/ /gm;
#     $text =~  s/[\p{isPunct}\p{IsSpacePerl}\n]+/ /gm;
    return $text;
}


=item set_nocase

 Fonction supprimant la case d'un texte, le texte devenant tout en minuscule

=cut

sub set_nocase{
    my $text = shift;
    $text = lc($text);
    return $text;
}


=item set_baliser

 my $text = set_baliser("mon text a baliser" , $resul_treated , "<balise de gauche>" , "</balise de droite>");
 Fonction supprimant la ponctuation d'un texte

=cut

sub set_baliser {
    my ($text , $result , $balise1 , $balise2 ) = @_;
    foreach (@$result){
        my $urls = $_->{urls};
        foreach (@$urls){
            my $text_offset = $_->{text_offset};
            foreach (@$text_offset){
                my $offset = $_->{offset};
                my $start  = $offset->[0]-1;
                my $end    = $offset->[1];
                $text =~ s/^((?:(?:[\s\.\?!:,;\"\-\\\(\)\[\]\{\}]?(?:<\/?.*?>)?)*[^\s\.\?!:,;\"\-\\\(\)\[\]\{\}]+){$start})((?:(?:[\s\.\?!:,;\"\-\\\(\)\[\]\{\}]?(?:<\/?.*?>)?)*[^\s\.\?!:,;\"\-\\\(\)\[\]\{\}]+){$end})/$1$balise1$2$balise2/m;
            }
        }
    }
    return $text;
}


=item get_name_of

 Fonction retournant le nom d'une langue suivant son abreviation

=cut

sub get_name_of{
    my $a = shift;
    my %h = (
        "AF" => "Afrikaans",
        "BG" => "Bulgarian",
        "BR" => "Breton",
        "BS" => "Bosnian",
        "CY" => "Welsh",
        "DA" => "Danish",
        "DE" => "German",
        "EN" => "English",
        "EO" => "Esperanto",
        "ES" => "Spanish",
        "ET" => "Estonian",
        "EU" => "Basque",
        "FI" => "Finnish",
        "FR" => "French",
        "FY" => "Frisian",
        "GA" => "Irish",
        "HR" => "Croatian",
        "HU" => "Hungarian",
        "ID" => "Indonesian",
        "IS" => "Icelandic",
        "IT" => "Italian",
        "LA" => "Latin",
        "LV" => "Latvian",
        "MS" => "Malay",
        "NL" => "Dutch",
        "NO" => "Norwegian",
        "PL" => "Polish",
        "PT" => "Portuguese",
        "RO" => "Romanian",
        "RU" => "Russian",
        "SL" => "Slovene",
        "SO" => "Somali",
        "SQ" => "Albanian",
        "SV" => "Swedish",
        "SW" => "Swahili",
        "TR" => "Turkish"
    );
    if(exists($h{uc($a)})){
        return $h{uc($a)};
    }
    return undef;
}

=item get_language

   Fonction retournant la langue (en abrege) d'un texte

=cut

sub get_language{
    use Lingua::Identify qw(:language_identification);
    my $text = shift(@_)."";
    my $a = langof($text);
    return $a;
}

END { }
1;
__END__

=back

=head1 AUTEUR

    noplagia dev team

    http://noplagia.org

=cut
